home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 3 / Amiga Tools 3.iso / rexx / joinpaths.pvrx < prev    next >
Text File  |  1992-08-25  |  5KB  |  221 lines
  1. /* JoinPaths.pvrx---Prompt user to select an end point each
  2.     from two paths by which the two paths should be joined.
  3.    Author: Jeff Blume
  4.    Copyright © 1991 by Stylus, Inc.
  5.  
  6.    Suggested "ProVector.pvrx" entries:
  7.  
  8.     'DefineKey J "JoinPaths MENU"'
  9.     'Define "JoinPaths  Ctrl-J" "JoinPaths MENU"'
  10.  
  11. */
  12.  
  13. /* Get the argument list to see whether this is a MENU, or an OK */
  14. arg arglist
  15. Cmd = word(arglist,1)
  16.  
  17. options results
  18.  
  19. /* Try to get exclusive lock on project window.
  20.     If can't get lock, not polite to interrupt. */
  21. 'Lock'
  22. if RC ~= 0 then exit
  23.  
  24. /* This loop is called from the menu */
  25. if Cmd = 'MENU' then
  26. DO
  27.     /* Magnetize Sel Objs for better coord identification.*/
  28.     'SelectList' Sel; SelN = Result
  29.     if SelN ~= 2 then do
  30.         RC = 100
  31.         call Error "Must Select Two Objects!"
  32.         end
  33.     else 'Magnetize' SelN Sel
  34.     'Prompt "Click Two Points To Join:"'
  35.     'GetUserData 0 2 2 "JoinPaths OK" ""'
  36. END
  37. /* end "MENU" loop */
  38.  
  39. /* This was called from GetUserData */
  40. if Cmd = 'OK' then
  41. DO
  42.     'EndPrompt'
  43.     'GetInputPoints Pts'
  44.     'PushUndo'
  45.     'SelectList' Sel; SelN = Result
  46.  
  47.     'Prompt "Looking for points."'
  48.     /* Identify objects and points */
  49.     do k=0 to 1
  50.         /* First try the easy way */
  51.         'ObjectAt' Pts.k.X Pts.k.Y; Obj.k = Result  /* Ctrl-Pt may return 0 or wrong obj! */
  52.         if Result = 0 then FindPT = WalkSelected()    /* Then the hard way */
  53.         else FindPt = TestPoints(Obj.k,"ONLY")
  54.         call TestFindPt
  55.     end
  56.     'EndPrompt'
  57.  
  58.     'Prompt "Joining Objects"'
  59.     /* Check that path direction is right for joining     */
  60.     /* One selected point must be first point of object, */
  61.     /* but both can't be. 1st-Pt=Indicator needs offset. */
  62.     if ObjPts.0.0.X = "INDICATOR" then FirstA = 1
  63.         else FirstA = 0
  64.     if ObjPts.1.0.X = "INDICATOR" then FirstB = 1
  65.         else FirstB = 0
  66.     select
  67.         when Idx.0 = FirstA & Idx.1 = FirstB then,
  68.             call  AddPoints 0,0,1
  69.         when Idx.0 ~= FirstA & Idx.1 ~= FirstB then,
  70.             call  AddPoints 1,0,1
  71.         when Idx.0 = FirstA & Idx.1 ~= FirstB then,
  72.             call  AddPoints R,1,0
  73.         when Idx.0 ~= FirstA & Idx.1 = FirstB then,
  74.             call  AddPoints R,0,1
  75.         otherwise NOP
  76.     end /* SELECT END */
  77.  
  78. /*
  79. call open STDOUT,"RAM:RxOut.txt",W
  80. call open STDERR,"RAM:RxErr.txt",W
  81. trace ?R
  82. */
  83.  
  84.     /* Clean up old objects */
  85.     'GetCurrAttrs' AttrsCur    /* Store current attributes */
  86.     'GetAttrs' Obj.0 AttrsObj    /* Store object attributes */
  87.     'TypeOf Sel.0'; ObjType = Result
  88.     /* De-Magnetize and delete seed objs */
  89.     'Magnetize' 0 Sel
  90.     do s=0 to 1
  91.         'Delete' Sel.s
  92.     end
  93.  
  94.     /* DRAW NEW MERGED OBJ! */
  95.     'SetCurrAttrs' AttrsObj    /* Set object attributes */
  96.     if ObjType = "Polyline" then 'Polyline' NumJoin ObjPts.A
  97.     else  'Polygon' NumJoin ObjPts.A
  98.     'SetCurrAttrs' AttrsCur    /* Restore current attributes */ 
  99.  
  100.     'EndPrompt'
  101.     'Repair'
  102.  
  103. END
  104. /* end "OK" loop */
  105.  
  106. 'UnLock'
  107. EXIT
  108.  
  109. ERROR:
  110.     arg ErrTxt
  111.     if RC ~= 0 & ErrTxt ~= "" then 'GetBool ErrTxt "Cancel" "Cancel"'
  112.     SelN = 0
  113.     'Magnetize' SelN Sel
  114.     'EndPrompt'
  115.     'UnLock'
  116.     exit
  117.  
  118. WALKSELECTED:
  119.     do i = 0 to SelN-1
  120.         FindPt = TestPoints(Sel.i,i)
  121.         select
  122.             when FindPt = "FOUND" then return "FOUND"
  123.             when i = SelN-1 & FindPt = "TEXTOBJ" then return "TEXTOBJ"
  124.             when i = SelN-1 then return "CAN'T FIND"
  125.             otherwise iterate
  126.         end /*SELECT END*/
  127.     end /* "i" DO END */
  128.  
  129. TESTPOINTS:
  130.     arg Obj,Count
  131.     'GetPoints' Obj ObjPts.k; NumPts=Result
  132.     if RC=18 & Count="ONLY" then call Error "CAN'T JOIN TEXT OR GROUP"
  133.     if RC = 18 then return "TEXTOBJ"
  134.  
  135.     do j = 0 to NumPts-1
  136.         select
  137.             when ObjPts.k.j.X = Pts.k.X & ObjPts.k.j.Y = Pts.k.Y then
  138.                 do
  139.                     Idx.k = j
  140.                     NmPts.k = NumPts
  141.                     return "FOUND"
  142.                 end
  143.             when j = NumPts-1 & Count = "ONLY" then,
  144.                 return "WRONGOBJ"
  145.             when j = NumPts-1 then return "TRYAGAIN"
  146.             otherwise iterate
  147.         end /*SELECT END*/
  148.     end /* "j" DO END */
  149.  
  150. TESTFINDPT:
  151.     if FindPt ~= "FOUND" then select
  152.         when FindPt = "WRONGOBJ" then
  153.             do
  154.                 RC = 100
  155.                 call Error "NO POINT; MUST BE FIRST OR LAST"
  156.             end
  157.         when FindPt = "TEXTOBJ" then
  158.             do
  159.                 RC = 100
  160.                 call Error "TEXT OR GROUP (OR NO POINT)."
  161.             end
  162.         otherwise
  163.             do
  164.                 RC=100
  165.                 call Error "NO POINT"
  166.             end
  167.         end /*SELECT END*/
  168.         return
  169.  
  170. ADDPOINTS:
  171.     /* Add the first object's points together   */
  172.     /* "R" is object to reverse */
  173.     /* "A" is base object to which "B" is added */
  174.     arg R, A, B
  175.     if R ~= "R" then call Reverse R
  176.     NumJoin = NmPts.A + NmPts.B
  177.     t = NmPts.A
  178.     do s = 0 to NmPts.B - 1
  179.         ObjPts.A.t.X = ObjPts.B.s.X
  180.         ObjPts.A.t.Y = ObjPts.B.s.Y
  181.         t = t + 1
  182.     end
  183.     return
  184.  
  185. REVERSE:
  186.     /* Reverse order of object */
  187.     arg R
  188.     SkipInd = "FALSE"
  189.     do s = 0  to NmPts.R - 1
  190.         t = NmPts.R - (s+1)
  191.         if SkipInd ~= "FALSE" then t = t + 1
  192.         if t = SkipInd then do
  193.             t = t - 1
  194.             SkipInd = "FALSE"
  195.             end
  196.         /*if t = SkipInd & t >= 1 then t = t - 1*/
  197.         if ObjPts.R.t.X = "INDICATOR" then do
  198.             s = s - 4
  199.             JoinedPts.s.X = ObjPts.R.t.X
  200.             JoinedPts.s.Y = ObjPts.R.t.Y
  201.             SkipInd = t
  202.             iterate s
  203.             end
  204.         JoinedPts.s.X = ObjPts.R.t.X
  205.         JoinedPts.s.Y = ObjPts.R.t.Y
  206.     end
  207.  
  208.     /* Put points back in original array */
  209.     do s = 0  to NmPts.R - 1
  210.         ObjPts.R.s.X = JoinedPts.s.X
  211.         ObjPts.R.s.Y = JoinedPts.s.Y
  212.     end
  213.     return
  214.  
  215. /*
  216. BUGS:
  217.  
  218.     1. Will not always join points that are coincident, at least in FFP
  219.         (from old note buried on desk - still true?)
  220.  
  221. */